Enigma Amiga Life 109/EnigmaAmiga109CD.iso/dalla rivista/amiga.free/sorgenti vari/wolfedit2 2.0.4 source.sit/WolfEdit2 2.0.4 Source/UMapListView.p

Text File | 1996-04-13 | 8KB | 398 lines

unit UMapListView;

interface
    uses
        UWolfDoc;

    const

        newLevelCmd = 401;
        getLevelInfoCmd = 403;

    procedure CreateLevel (view: TView);
    procedure GetInfoForLevel (view: TView; n: integer);

implementation
    uses
        UGoof, UList, UXWindow, ULevelInfo, UFree;

    const

        openLevelCmd = 402;

        mapListWinID = 129;

        levelInfoScrapType = 'W3dP';
        levelRsrcScrapType = 'W3dR';

    type

        TMapListView = object(TList)
                fMapList: TMapListDoc;
                fUndo: TMapListUndo;
                procedure IMapListView (itsMapList: TMapListDoc);
                procedure Free;
                override;
                procedure DiscardUndo;
                procedure DrawCell (cell: Point; r: Rect; var hilite: boolean);
                override;
                procedure SetupMenus;
                override;
                procedure DoMenuCommand (cmdNumber: integer);
                override;
                procedure DoubleClick (var e: EventInfo);
                override;
                procedure DoNewLevel;
                procedure DoOpenLevel;
                procedure DoGetInfo;
                procedure GetInfoFor (n: integer);
                procedure DoUndo;
                procedure DoCut;
                procedure DoCopy;
                procedure DoPaste;
                procedure DoClear;
                function CheckEdit (what: string; result: OSErr): boolean;
                function Copy: OSErr;
                function Clear: OSErr;
                procedure UpdateDimensions;
            end;

        TMapListUndo = object(TObject)
                fNext: TMapListUndo;
                fLevelNumber: integer;
                fInfo: LevelInfoHandle;
                fResource: LevelHandle;
            end;

        TMapListWindow = object(TXWindow)
                fMapListView: TMapListView;
                procedure Close;
                override;
                procedure Activate;
                override;
            end;

    procedure TMapListWindow.Close;
    begin
        if fDocument.DoClose(false) then
            ;
    end;

    procedure TMapListWindow.Activate;
    begin
        inherited Activate;
        fMapListView.BecomeTarget;
    end;

    procedure TMapListDoc.MakeWindow;
        var
            win: TMapListWindow;
            view: TMapListView;
    begin
        new(win);
        win.IGetNewWindow(self, mapListWinID, [wGoAwayBox, wGrowBox, wCloseOnGoAway]);
        new(view);
        view.IMapListView(self);
        win.fMapListView := view;
        win.Place(view, nil, nil, 0, 0, fill, fill, [frmVScroll, frmGrowBox, frmHResize, frmVResize, frmBorder]);
        win.Show;
        if (fNumLevels = 1) & (fIndex^^[1].resource = nil) then
            OpenLevel(1);
    end;

    procedure TMapListView.IMapListView (itsMapList: TMapListDoc);
        var
            cellSize, borderSize: Point;
            dimensions: Rect;
    begin
        SetPt(cellSize, 1024, 16);
        SetPt(borderSize, 0, 0);
        SetRect(dimensions, 0, 1, 1, 1);
        IListX(cellSize, borderSize, dimensions, []);
        fMapList := itsMapList;
        if itsMapList <> nil then
            itsMapList.fView := self;
        fUndo := nil;
        UpdateDimensions;
    end;

    procedure TMapListView.Free;
    begin
        DiscardUndo;
        inherited Free;
    end;

    procedure TMapListView.DiscardUndo;
        var
            u: TMapListUndo;
    begin
        while fUndo <> nil do begin
                u := fUndo;
                fUndo := fUndo.fNext;
                if u.fInfo <> nil then
                    DisposeLevelInfo(u.fInfo);
                if u.fResource <> nil then
                    DisposeLevel(u.fResource);
                u.Free;
            end;
    end;

    procedure TMapListView.DrawCell (cell: Point; r: Rect; var hilite: boolean);
        var
            number: string[6];
    begin
        TextFont(geneva);
        TextSize(12);
        if hilite then begin
                FillRect(r, black);
                TextMode(srcBic);
                hilite := false;
            end
        else begin
                FillRect(r, white);
                TextMode(srcOr);
            end;
        number := StringOf(cell.v : 1);
        MoveTo(r.left + 20 - StringWidth(number), r.bottom - 4);
        DrawString(number);
        Move(10, 0);
        DrawString(fMapList.GetLevelName(cell.v));
    end;

    procedure TMapListView.SetupMenus;

        function ProbeScrap (typ: OSType): boolean;
            var
                offset: longint;
        begin
            ProbeScrap := GetScrap(nil, typ, offset) >= 0;
        end;

    begin
        EnableCmd(newLevelCmd);
        if not EmptyRect(fSelection) then begin
                EnableCmd(openLevelCmd);
                EnableCmd(getLevelInfoCmd);
                EnableCmd(cutCmd);
                EnableCmd(copyCmd);
                EnableCmd(clearCmd);
            end;
        if ProbeScrap(levelInfoScrapType) & ProbeScrap(levelRsrcScrapType) then
            EnableCmd(pasteCmd);
        if fUndo <> nil then
            EnableCmd(undoCmd);
        inherited SetupMenus;
    end;

    procedure TMapListView.DoMenuCommand (cmdNumber: integer);
    begin
        case cmdNumber of
            newLevelCmd:
                DoNewLevel;
            openLevelCmd:
                DoOpenLevel;
            getLevelInfoCmd:
                DoGetInfo;
            undoCmd:
                DoUndo;
            cutCmd:
                DoCut;
            copyCmd:
                DoCopy;
            pasteCmd:
                DoPaste;
            clearCmd:
                DoClear;
            otherwise
                inherited DoMenuCommand(cmdNumber);
        end;
    end;

    procedure TMapListView.DoUndo;
        var
            u: TMapListUndo;
    begin
        while fUndo <> nil do begin
                u := fUndo;
                fUndo := fUndo.fNext;
                fMapList.InsertLevel(u.fLevelNumber, u.fInfo, u.fResource);
                UpdateDimensions;
                SetSelection(0, u.fLevelNumber, 1, u.fLevelNumber + 1);
                u.Free;
            end;
        Invalidate;
    end;

    function TMapListView.CheckEdit (what: string; result: OSErr): boolean;
    begin
        if result = noErr then
            CheckEdit := true
        else begin
                fMapList.LevelError(what, fSelection.top, result);
                CheckEdit := false;
            end;
    end;

    procedure TMapListView.DoCut;
    begin
        if CheckEdit('cut', Copy) then
            if CheckEdit('cut', Clear) then
                ;
    end;

    procedure TMapListView.DoCopy;
    begin
        if CheckEdit('copy', Copy) then
            ;
    end;

    function TMapListView.Copy: OSErr;
        var
            p, h: Handle;

        procedure Check (result: longint);
        begin
            if result < 0 then begin
                    Copy := result;
                    exit(Copy);
                end;
        end;

        procedure WriteScrap (h: Handle; typ: OSType);
        begin
            Check(PutScrap(GetHandleSize(h), typ, h^));
        end;

    begin {Copy}
        with fMapList.fIndex^^[fSelection.top] do begin
                p := Handle(info);
                h := Handle(resource);
            end;
        Check(ZeroScrap);
        WriteScrap(p, levelInfoScrapType);
        WriteScrap(h, levelRsrcScrapType);
        Copy := noErr;
    end;

    procedure TMapListView.DoPaste;
        var
            p, h: Handle;
            len, offset: longint;
            n: integer;

        procedure Check (result: longint);
        begin
            if result < 0 then begin
                    DoAlert(clipReadFailedAlertID);
                    DisposHandle(p);
                    DisposHandle(h);
                    exit(DoPaste);
                end;
        end;

    begin {DoPaste}
        p := NewHandle(0);
        h := NewHandle(0);
        Check(GetScrap(p, levelInfoScrapType, offset));
        Check(GetScrap(h, levelRsrcScrapType, offset));
        if not EmptyRect(fSelection) then
            n := fSelection.top
        else
            n := fMapList.fNumLevels + 1;
        fMapList.InsertLevel(n, LevelInfoHandle(p), LevelHandle(h));
        UpdateDimensions;
        SetSelection(0, n, 1, n + 1);
        Invalidate;
    end;

    procedure TMapListView.DoClear;
    begin
        if CheckEdit('clear', Clear) then
            ;
    end;

    function TMapListView.Clear: OSErr;
        var
            n: integer;
            u: TMapListUndo;

        procedure Check (result: longint);
        begin
            if result < 0 then begin
                    Clear := result;
                    exit(Clear);
                end;
        end;

    begin {Clear}
        n := fSelection.top;
        DiscardUndo;
        new(u);
        u.fNext := fUndo;
        fUndo := u;
        u.fLevelNumber := n;
        Check(fMapList.CutLevel(n, u.fInfo, u.fResource));
        ClearSelection;
        Invalidate;
        UpdateDimensions;
        Clear := noErr;
    end;

    procedure TMapListView.DoubleClick (var e: EventInfo);
    begin
        if not EmptyRect(fSelection) then
            DoOpenLevel;
    end;

    procedure TMapListView.DoNewLevel;
        var
            n: integer;
    begin
        fMapList.NewLevel;
        fMapList.Changed;
        UpdateDimensions;
        n := fMapList.fNumLevels;
        fMapList.OpenLevel(n);
        SetSelection(0, n, 1, n + 1);
    end;

    procedure TMapListView.DoOpenLevel;
    begin
        fMapList.OpenLevel(fSelection.top);
    end;

    procedure TMapListView.DoGetInfo;
    begin
        GetInfoFor(fSelection.top);
    end;

    procedure TMapListView.GetInfoFor (n: integer);
        var
            map: TMap;
    begin
        if EditLevelInfo(fMapList, n) then begin
                fMapList.Changed;
                InvalidateCells(fSelection);
                map := fMapList.fIndex^^[n].map;
                if (map <> nil) & (map.fView <> nil) then
                    map.fView.fFrame.fWindow.UpdateTitle;
                fFrame.fWindow.UpdateTitle;
            end;
    end;

    procedure TMapListView.UpdateDimensions;
    begin
        SetDimensions(0, 1, 1, fMapList.fNumLevels + 1);
    end;

    procedure CreateLevel (view: TView);
    begin
        TMapListView(view).DoNewLevel;
    end;

    procedure GetInfoForLevel (view: TView; n: integer);
    begin
        TMapListView(view).GetInfoFor(n);
    end;

end.